home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 7
/
FM Towns Free Software Collection 7.iso
/
t_os
/
mer_fnt
/
mer_fnt.bas
next >
Wrap
BASIC Source File
|
1993-11-30
|
28KB
|
752 lines
10000 '
10010 ' mer_fnt.bas (93/01/05) - 93/08/17
10020 ' by TEMITORAVIOS
10030 '
10040 ' 2つのフォントファイルを読み込んで、指定した部分を複写するものです。
10050 ' IBM DOS/V のフォントを読み込む機能も有ります。
10060 '
10070 CLEAR ,,,450000 '配列変数領域
10080 DEFINT A-Z
10090 F_MAX& = 110592/2-1 'system font のサイズ
10100 FT_MAX& = 200000/2 'fontex font のサイズ
10110 DIM FT%(F_MAX&,1),DSP%(12),SEL_BK&(50,1),SEL_NM$(50)
10120 DIM TMP%(FT_MAX&):ERASE TMP% '確保出来るかcheck
10130 '
10140 ' sjis コードから 12ドットフォントファイル内の 格納位置を求める バイト単位
10150 DEF FNSJAD&(N&)= 256*12 + ((INT(N&/256) - &H81)*188 + (N& MOD 256) -&H40 +((N& MOD 256)> &H7F))*24
10160 ' 2バイト chr$()
10170 DEF FNSJCH$(N&)=CHR$(INT(N&/256))+CHR$(N& MOD 256)
10180 ' 範囲表示用
10190 DEF FNHANI$(T&,B&)=" 範囲 $"+HEX$(T&)+" ("+FNSJCH$(T&)+") - $"+HEX$(B&)+ " ("+FNSJCH$(B&)+")"
10200 ' だいたいの表示範囲
10210 DEF FNADSTP(N)=-(PUT_TYPE = 0)*(20*18) + -(PUT_TYPE = 1)*(24*25) + -(PUT_TYPE = 2)*(10*11)
10220 '
10230 ' sjis コードの調整(存在しないコードをスキップ)をする
10240 DEF FNSJADJ1&(N&) = (N& -((N& MOD 256) = &H7F))*(&H40 <= (N& MOD 256))*((N& MOD 256) <= &HFC) ' n& の下位バイトが $40 - $fc の時($7fスキップ)
10250 DEF FNSJADJ2&(N&) = (INT(N&/256)*256+&H40)*-((N& MOD 256) < &H40) '<$40
10260 DEF FNSJADJ3&(N&) = ((INT(N&/256)+1)*256+&H40)*-((N& MOD 256) > &HFC) '>$fc
10270 DEF FNSJADJ&(N&) = FNSJADJ1&(N&) + FNSJADJ2&(N&) + FNSJADJ3&(N&)
10280 ' 存在しないコードを表示しないように。 ( FT%(N,BUF)の宣言されてない範囲を表示参照しないように )
10290 DEF FNBTMCHK&(N&) = (&H9872 - FNADSTP(0))*-(SJ_CODE& > (&H9872 - FNADSTP(0))) + (SJ_CODE&)*-(SJ_CODE& <= (&H9872 - FNADSTP(0)))
10300 '0
10310 '
10320 I = 0
10330 READ S$: WHILE S$ <> "**"
10340 READ E$,N$
10350 SEL_BK&(I,0) = VAL("&h"+S$)
10360 SEL_BK&(I,1) = VAL("&h"+E$)
10370 SEL_NM$(I) = N$
10380 I = I + 1
10390 READ S$: WEND
10400 SEL_MAX = I
10410 '
10420 'フォント分類
10430 DATA 00, 00, "- コード 入力 -"
10440 DATA 00, ff, " ANK文字 "
10450 DATA 8140, 81fc, " 記 号 "
10460 DATA 824f, 8258, " 数 字 "
10470 DATA 8260, 829a, " アルファベット"
10480 DATA 829f, 82f2, " ひ ら が な "
10490 DATA 8340, 8396, " カ タ カ ナ "
10500 DATA 839f, 83d6, " ギリシャ文字 "
10510 DATA 8440, 8491, " ロシア文字 "
10520 DATA 849f, 84d4, " 罫 線 "
10530 DATA 889f, 9872, "第一水準JIS漢字"
10540 DATA **
10550 '
10560 BUF = 0
10570 PUT_TYPE = 0
10580 PUT_BACK = 1
10590 SJ_CODE& = &H8140
10600 B_FNAME$(0) = ".\"
10610 B_FNAME$(1) = ".\"
10620 '
10630 '画面
10640 CLS
10650 CONSOLE 18,7
10660 LINE (0, 0)-STEP(319,319),PSET,7,B
10670 LINE (320,0)-STEP(319,319),PSET,7,B
10680 MENU = 1
10690 '
10700 GOSUB *FILE_READ
10710 *LOOP
10720 '
10730 IF MENU = 1 THEN
10740 LINE (2 + BUF *320,2)-STEP(316,319-4),PSET,4,B
10750 LINE (2 + -(BUF=0)*320,2)-STEP(316,319-4),PSET,0,B '反対側カーソル消す
10760 COLOR 15 '反転表示
10770 LOCATE BUF*40,17
10780 PRINT B_FNAME$(BUF);
10790 COLOR 7
10800 LOCATE -(BUF = 0)*40,17
10810 PRINT B_FNAME$(ABS(1-BUF));
10820 '
10830 CLS 1 'スクロール領域
10840 PRINT " 0 .. 表示選択 ↑,↓.. 表示切替 ←,→.. バッファ切替"
10850 PRINT ""
10860 PRINT " 1 .. 複写 4 .. 読み込み * .. 表示形式 / .. 枠表示"
10870 PRINT " 2 .. 消去 5 .. 書き込み + .. 再表示 - .. 表示中断"
10880 PRINT " 6 .. DOS/V font 読込 = .. 表示範囲を左右あわせる"
10890 PRINT " 9 .. 終了"
10900 MENU = 0
10910 ENDIF
10920 '
10930 I$ = INPUT$(1)
10940 IF I$ = "0" THEN
10950 GOSUB *CODE_SEL
10960 ELSE IF I$ = "1" THEN
10970 GOSUB *CODE_COPY
10980 ELSE IF I$ = "2" THEN
10990 GOSUB *CODE_CLR
11000 'ELSE IF I$ = "3" THEN
11010 ' GOSUB *CODE_EFFECT
11020 ELSE IF I$ = "4" THEN
11030 GOSUB *FILE_READ
11040 ELSE IF I$ = "5" THEN
11050 GOSUB *FILE_WRITE
11060 ELSE IF I$ = "6" THEN
11070 GOSUB *FONTEX_READ
11080 ELSE IF I$ = "9" THEN
11090 GOSUB *EXIT
11100 ELSE IF I$ = "*" THEN
11110 GOSUB *TYPE_CHANGE
11120 ELSE IF I$ = "/" THEN
11130 GOSUB *BACK_CHANGE
11140 ELSE IF I$ = "+" THEN
11150 GOSUB *BUF_REF
11160 ELSE IF I$ = "=" THEN
11170 GOSUB *BUF_REF_2
11180 ELSE IF I$ = CHR$(&H1E) THEN 'up_ar
11190 GOSUB *UP_PAGE
11200 ELSE IF I$ = CHR$(&H1F) THEN 'down_ar
11210 GOSUB *DOWN_PAGE
11220 ELSE IF I$ = CHR$(&H1C) THEN 'right_ar
11230 GOSUB *BUF_CHANGE
11240 ELSE IF I$ = CHR$(&H1D) THEN 'left_ar
11250 GOSUB *BUF_CHANGE
11260 ELSE IF I$ = CHR$(&H14) THEN 'ctrl+T
11270 GOSUB *TEM_FNT
11280 ENDIF
11290 GOTO *LOOP
11300 '
11310 END
11320 '----処理ルーチン---------------------------------------
11330 *CODE_SEL
11340 '表示先頭を選ぶ。
11350 CLS 1
11360 PRINT "== 表示選択 =="
11370 PRINT "どの種類から? ← → 選択 (↑表示 , RET決定)"
11380 SEL_BNK = 0: SEL_CSR = 2 '全角から
11390 GOSUB *SEL_AR
11400 SJ_CODE& = SEL_OUT&
11410 SJ_CODE& = FNBTMCHK&(SJ_CODE&) ' : BUF_PUT = 1
11420 GOSUB *FNT_PUT
11430 MENU = 1
11440 RETURN
11450 '
11460 *CODE_COPY
11470 '指定した部分を反対のバッファに複写する
11480 GOSUB *SEL_CODE
11490 BUF = -(BUF = 0) '相手側フォント表示
11500 GOSUB *FNT_PUT '
11510 BUF = -(BUF = 0) '
11520 '複写方向の確認
11530 PRINT "== フォント複写 =="
11540 PRINT FNHANI$(SEL_TOP&,SEL_BTM&)
11550 IF BUF = 0 THEN
11560 PRINT "["+B_FNAME$(0)+"] → ["+B_FNAME$(1)+"] の方向に複写します。"
11570 ELSE
11580 PRINT "["+B_FNAME$(0)+"] ← ["+B_FNAME$(1)+"] の方向に複写します。"
11590 ENDIF
11600 PRINT " [RET] 実行 [ESC] 取消"
11610 WAIT 10:WHILE INKEY$ <> "":WEND
11620 IF INPUT$(1) <> CHR$(13) THEN
11630 GOTO *CODE_COPY_T
11640 ENDIF
11650 PRINT " -- 処理中 --"
11660 IF (SEL_BTM& < 256) THEN '半角コード
11670 FOR I = SEL_TOP&*6 TO SEL_BTM&*6+5
11680 FT%(I,-(BUF=0)) = FT%(I,BUF)
11690 NEXT
11700 ELSE '全角コード
11710 FOR I! = FNSJAD&(SEL_TOP&)/2 TO FNSJAD&(SEL_BTM&)/2+11
11720 FT%(I!,-(BUF=0)) = FT%(I!,BUF)
11730 NEXT
11740 ENDIF
11750 BUF = -(BUF = 0) '相手側のみ表示
11760 BUF_PUT = 1
11770 GOSUB *FNT_PUT
11780 BUF = -(BUF = 0)
11790 *CODE_COPY_T
11800 MENU = 1
11810 RETURN
11820 '
11830 *CODE_CLR
11840 '表示されない部分に入ったゴミを消す。 FNTMAKEで気になったもので..
11850 GOSUB *SEL_CODE
11860 PRINT "== フォント消去 =="
11870 PRINT FNHANI$(SEL_TOP&,SEL_BTM&)
11880 PRINT " [RET] 実行 [ESC] 取消"
11890 WAIT 10:WHILE INKEY$ <> "":WEND
11900 IF INPUT$(1) <> CHR$(13) THEN
11910 GOTO *CODE_CLR_T '中止
11920 ENDIF
11930 PRINT " -- 処理中 --"
11940 IF (SEL_BTM& < 256) THEN '半角コード
11950 FOR I = SEL_TOP&*6 TO SEL_BTM&*6+5
11960 FT%(I,BUF) = 0
11970 NEXT
11980 ELSE '全角コード
11990 FOR I! = FNSJAD&(SEL_TOP&)/2 TO FNSJAD&(SEL_BTM&)/2+11
12000 FT%(I!,BUF) = 0
12010 NEXT
12020 ENDIF
12030 BUF_PUT = 1
12040 GOSUB *FNT_PUT
12050 *CODE_CLR_T
12060 MENU = 1
12070 RETURN
12080 '
12090 *CODE_EFFECT
12100 ' 0-3 , 8-11 の部分のみ太くする
12110 ' 12x12ではさすがに苦しい (もともとは98のゲームで見た表示)のと、
12120 ' 動作がおかしいのでメニューから外す。
12130 GOSUB *SEL_CODE
12140 PRINT "== フォント変形 =="
12150 PRINT FNHANI$(SEL_TOP&,SEL_BTM&)
12160 PRINT " [RET] 実行 [ESC] 取消"
12170 WAIT 10:WHILE INKEY$ <> "":WEND
12180 IF INPUT$(1) <> CHR$(13) THEN
12190 GOTO *CODE_EFFECT_T '中止
12200 ENDIF
12210 PRINT " -- 処理中 --"
12220 IF (SEL_BTM& < 256) THEN '半角コード
12230 FOR I! = SEL_TOP&*6 TO SEL_BTM&*6+5 STEP 6
12240 FOR J = 0 TO 11
12250 IF J <=3 OR 8 <= J THEN
12260 D = PEEK(VARPTR(FT%(I!,BUF))+J)
12270 POKE VARPTR(FT%(I!,BUF))+J, (D OR INT(D/2)) AND &HFC
12280 ENDIF
12290 NEXT
12300 NEXT
12310 ELSE '全角コード
12320 FOR I! = 0 TO (FNSJAD&(SEL_BTM&) - FNSJAD&(SEL_TOP&))/2 STEP 12
12330 FOR J = 0 TO 11
12340 IF J <=3 OR 8 <= J THEN
12350 AD& = FNSJAD&(SEL_TOP&)/2 + I! + J
12360 D = FT%(AD&,BUF)
12370 FT%(AD&,BUF) = D OR INT(D / 2) AND &HFFF0
12380 ENDIF
12390 NEXT
12400 NEXT
12410 ENDIF
12420 BUF_PUT = 1
12430 GOSUB *FNT_PUT
12440 *CODE_EFFECT_T
12450 MENU = 1
12460 RETURN
12470 '
12480 *FILE_READ
12490 CLS 1
12500 PRINT "== フォントファイル読み込み =="
12510 OLD_NAME$ = B_FNAME$(BUF)
12520 WILD$ = "*.fnt"
12530 RD_WT = 0
12540 GOSUB *FILE_NAME
12550 IF FL_NAME$ = "-" THEN GOTO *FILE_READ_T '中止
12560 B_FNAME$(BUF) = FL_NAME$
12570 PRINT " -- 処理中 --"
12580 DIM TMP%(F_MAX&) '直接必要な位置に読み出せないため
12590 'ファイル名を入力するルーチンでファイルがある事を確認している
12600 LOAD@ FL_NAME$,TMP%
12610 FOR I! = 0 TO F_MAX&
12620 FT%(I!,BUF) = TMP%(I!)
12630 NEXT
12640 ERASE TMP%
12650 BUF_PUT = 1
12660 GOSUB *FNT_PUT
12670 *FILE_READ_T
12680 MENU = 1
12690 RETURN
12700 '
12710 *FILE_WRITE
12720 CLS 1
12730 PRINT "== フォントファイル書き込み =="
12740 OLD_NAME$ = B_FNAME$(BUF)
12750 WILD$ = "*.fnt"
12760 RD_WT = 1
12770 GOSUB *FILE_NAME
12780 IF FL_NAME$ = "-" THEN GOTO *FILE_WRITE_T '中止
12790 B_FNAME$(BUF) = FL_NAME$
12800 PRINT " -- 処理中 --"
12810 DIM TMP%(F_MAX&) 'ファイルサイズを合わせる為に配列を用意する
12820 FOR I! = 0 TO F_MAX&
12830 TMP%(I!) = FT%(I!,BUF)
12840 NEXT
12850 'ファイル名を入力する部分で 同名のファイルは .BAK に変更されている
12860 SAVE@ FL_NAME$,TMP%
12870 ERASE TMP%
12880 *FILE_WRITE_T
12890 MENU = 1
12900 RETURN
12910 '
12920 *FONTEX_READ
12930 ' DOS/V 用フォントを読み込む
12940 CLS 1
12950 PRINT "== DOS/Vフォント 読み込み =="
12960 OLD_NAME$ = "-"
12970 WILD$ = "*.*"
12980 RD_WT = 0
12990 GOSUB *FILE_NAME
13000 IF FL_NAME$ = "-" THEN GOTO *FONTEX_READ_T
13010 DIM TMP%(FT_MAX&)
13020 'メモリに入り切らない時は FT_MAX&を 増やす
13030 LOAD@ FL_NAME$,TMP%
13040 '
13050 ' フォントデータが 1バイトずれているので 配列変数では扱えず、peek,poke で処理している
13060 KN_AD& = VARPTR(TMP%(0)) 'DOS/V フォントデータ先頭
13070 ' ID check
13080 I$ = ""
13090 FOR I = 0 TO 5
13100 I$ = I$ + CHR$(PEEK(KN_AD&+I))
13110 NEXT
13120 IF I$ <> "FONTX2" THEN
13130 PRINT "FONTEX用 font ではありません。 [hit any key]"
13140 I$ = INPUT$(1)
13150 GOTO *NOT_FONTEX
13160 ENDIF
13170 I$ = ""
13180 ' font name print
13190 FOR I = 6 TO 13
13200 I$ = I$ + CHR$(PEEK(KN_AD&+I))
13210 NEXT
13220 PRINT "FONT NAME =" + I$
13230 '
13240 IF PEEK(KN_AD& +16) = 0 THEN '半角フォント?
13250 ' -- 半角フォント 処理 --
13260 F_TYPE = 0
13270 PRINT "半角のフォントデータです。"
13280 IF PEEK(KN_AD& +14) <> 6 OR PEEK(KN_AD& +15) <> 12 THEN
13290 PRINT "フォントサイズが違います。 (";PEEK(KN_AD&+14);"x";PEEK(KN_AD& +15);") [hit any key]"
13300 I$ = INPUT$(1)
13310 GOTO *NOT_FONTEX
13320 ENDIF
13330 '半角 合成 アドレスを合わせて書き移すだけ
13340 TW_AD& = VARPTR(FT%(0,BUF))
13350 KN_AD& = VARPTR(TMP%(0))+17
13360 FOR I = 1 TO 256*12
13370 POKE TW_AD&,PEEK(KN_AD&)
13380 TW_AD& = TW_AD& + 1
13390 KN_AD& = KN_AD& + 1
13400 NEXT
13410 ELSE IF PEEK(KN_AD& +16) = 1 THEN '全角フォント?
13420 ' -- 全角フォント 処理 --
13430 F_TYPE = 1
13440 PRINT "全角のフォントデータです。"
13450 IF PEEK(KN_AD& +14) <> 12 OR PEEK(KN_AD& +15) <> 12 THEN
13460 PRINT "フォントサイズが違います。 (";PEEK(KN_AD&+14);"x";PEEK(KN_AD& +15);") [hit any key]"
13470 I$ = INPUT$(1)
13480 GOTO *NOT_FONTEX
13490 ENDIF
13500 '
13510 KN_TB& = VARPTR(TMP%(0))+18 '領域テーブル先頭
13520 KN_TBN = PEEK(KN_TB& -1) '領域テーブルのサイズ (と言うより個数)
13530 KN_FD& = KN_TB& + KN_TBN*4 'フォントデータ先頭
13540 AD& = VARPTR(FT%(0,BUF)) '複写先計算用
13550 '
13560 FOR I = 1 TO KN_TBN
13570 KN_ST& = PEEK(KN_TB& + 1)*256 + PEEK(KN_TB&) 'フォント範囲の始り (sjis)
13580 KN_ED& = PEEK(KN_TB& + 3)*256 + PEEK(KN_TB& + 2) 'フォント範囲の終わり
13590 KN_TB& = KN_TB& + 4
13600 IF KN_ST& > &H9872 THEN '第2水準が出たら打切り
13610 I = KN_TBN
13620 '全角と違い表示個数が同じなので同ルーチンで処理
13630 ELSE '第1水準ならば処理
13640 PRINT CHR$(13)+FNHANI$(KN_ST&,KN_ED&)+" 処理中"; '処理範囲表示
13650 FOR J = 0 TO KN_ED& - KN_ST&
13660 ' sjis コードを フォントファイルのアドレスに変換
13670 TW_AD& = AD& + FNSJAD&(J + KN_ST&) '書き移し先のアドレス
13680 FOR K = 1 TO 2*12 'フォントのバイト数書き移す
13690 POKE TW_AD& , PEEK(KN_FD&)
13700 TW_AD& = TW_AD& + 1
13710 KN_FD& = KN_FD& + 1
13720 NEXT
13730 NEXT
13740 ENDIF
13750 NEXT
13760 ENDIF
13770 '読み込んだ種類の文字を表示
13780 IF F_TYPE = 0 THEN
13790 SJ_CODE& = 0 '半角文字
13800 ELSE
13810 IF SJ_CODE& < 256 THEN SJ_CODE& = &H8140 '全角文字
13820 ENDIF
13830 GOSUB *FNT_PUT
13840 *NOT_FONTEX
13850 ERASE TMP%
13860 *FONTEX_READ_T
13870 MENU = 1
13880 RETURN
13890 '
13900 *EXIT
13910 CLS 1
13920 PRINT "== 終了 =="
13930 PRINT
13940 PRINT " MER_FNT を 終了します。"
13950 PRINT
13960 PRINT " [RET] 実行 [ESC] 取消"
13970 WAIT 10:WHILE INKEY$ <> "":WEND
13980 IF INPUT$(1) <> CHR$(13) THEN
13990 MENU = 1
14000 RETURN
14010 ENDIF
14020 SYSTEM
14030 END
14040 '
14050 *UP_PAGE
14060 ' 表示範囲をずらす
14070 AD& = FNADSTP(0) '表示形式によって増加する量を変化させる
14080 SJ_CODE& = FNSJADJ&(SJ_CODE& - AD&) '存在しないコードをスキップ
14090 IF SJ_CODE& < &H8140 THEN SJ_CODE& = &H8140 'sjis コードの範囲?
14100 GOSUB *FNT_PUT
14110 RETURN
14120 '
14130 *DOWN_PAGE
14140 ' 表示範囲をずらす
14150 AD& = FNADSTP(0)
14160 SJ_CODE& = FNSJADJ&(SJ_CODE& + AD&)
14170 SJ_CODE& = FNBTMCHK&(SJ_CODE&) '第一水準のフォントまでしか表示しないように
14180 GOSUB *FNT_PUT
14190 RETURN
14200 '
14210 *BUF_CHANGE
14220 ' 反対側のバッファに移る
14230 BUF = -(BUF = 0)
14240 SJ_CODE& = BUF_TOP&(BUF)
14250 GOSUB *FNT_PUT
14260 MENU = 1
14270 RETURN
14280 '
14290 *TYPE_CHANGE
14300 ' フォントの表示タイプを 変更する
14310 PUT_TYPE = PUT_TYPE +1
14320 IF PUT_TYPE > 2 THEN PUT_TYPE = 0
14330 BUF_PUT = 1 'BUF_TOP&(0) = -1 : BUF_TOP&(1) = -1
14340 GOSUB *FNT_PUT
14350 RETURN
14360 '
14370 *BACK_CHANGE
14380 ' フォント表示の枠を付けるかのスイッチ変更
14390 PUT_BACK = -(PUT_BACK = 0)
14400 BUF_PUT = 1
14410 GOSUB *FNT_PUT
14420 RETURN
14430 '
14440 *BUF_REF
14450 ' バッファの再表示 (中断したときの為)
14460 BUF_PUT = 1
14470 GOSUB *FNT_PUT
14480 RETURN
14490 '
14500 *BUF_REF_2
14510 ' 反対のバッファの表示先頭を揃える
14520 'BUF_PUT = 1
14530 'GOSUB *FNT_PUT
14540 BUF = -(BUF = 0)
14550 GOSUB *FNT_PUT
14560 BUF = -(BUF = 0)
14570 RETURN
14580 '
14590 *TEM_FNT
14600 ' オリジナルフォント読み込み
14610 FL_NAME$ = "tem_ita.fnt" 'TEMITORAVIOS オリジナル の イタリック もどき font の意味
14620 GOSUB *FL_EXIST
14630 IF FL_EXIST = 0 THEN
14640 PRINT "TEM_ITA.FNT が カレントディレクトリに見つかりません。 (Hit any key.)"
14650 I$ = INPUT$(1)
14660 GOTO *TEM_FNT_T
14670 ENDIF
14680 DIM TMP%(6*16*6)
14690 LOAD@ "tem_ita.fnt",TMP%
14700 FOR I = &H20*6 TO &H7F*6+5
14710 FT%(I,BUF) = TMP%(I - &H20*6)
14720 NEXT
14730 ERASE TMP%
14740 SJ_CODE& = 0:BUF_PUT = 1
14750 GOSUB *FNT_PUT
14760 *TEM_FNT_T
14770 MENU = 1
14780 RETURN
14790 '
14800 '----サブルーチン---------------------------------------
14810 '---- ファイル名入力 ----
14820 *FILE_NAME
14830 'in old_name$ , wild$ ,rd_wt out fl_name$
14840 '
14850 *FILE_NAME2
14860 PRINT "ファイル名を入力してください。 (省略時["+OLD_NAME$+"] `-' .. 中止)"
14870 PRINT "ファイル名 >";
14880 LINE INPUT FL_NAME$
14890 IF FL_NAME$ = "" THEN FL_NAME$ = OLD_NAME$
14900 IF FL_NAME$ = "-" OR FL_NAME$ = " " THEN
14910 FL_NAME$ = "-"
14920 GOTO *FILE_NAME_T '中止
14930 ENDIF
14940 IF MID$(FL_NAME$,LEN(FL_NAME$)) = "\" THEN '終わりが '\' のとき files
14950 FILES FL_NAME$+WILD$
14960 LOCATE 0,CSRLIN -1
14970 PRINT CHR$(13)+" "+CHR$(13);
14980 LOCATE 0,CSRLIN -1
14990 PRINT CHR$(13)+" "+CHR$(13);
15000 GOTO *FILE_NAME2
15010 ENDIF
15020 'ファイルの存在確認
15030 ER = 0
15040 GOSUB *FL_EXIST
15050 IF RD_WT = 0 THEN 'ファイルリードの時ファイルが有ることを確認
15060 IF FL_EXIST = 0 THEN
15070 PRINT "ファイルがみつかりません。 "
15080 GOTO *FILE_NAME2 '再入力
15090 ENDIF
15100 ELSE IF RD_WT = 1 THEN 'ファイルライトの時
15110 IF FL_EXIST = 1 THEN '同名のファイルがある時バックアップファイルを作る
15120 FL_BAK$ = FL_NAME$
15130 I = INSTR(FL_NAME$,".") '拡張子付けない馬鹿もいないだろう。
15140 FL_BAK$ = MID$(FL_BAK$,1,I-1)+".bak"
15150 ON ERROR GOTO *FL_SKIP
15160 KILL FL_BAK$
15170 ON ERROR GOTO 0
15180 NAME FL_NAME$ AS FL_BAK$
15190 ENDIF
15200 ENDIF
15210 *FILE_NAME_T
15220 RETURN
15230 '
15240 *FL_EXIST
15250 'in fl_name$ out fl_exist 1 ..ファイルあり 0 .. ファイルなし
15260 FL_EXIST = 1
15270 ON ERROR GOTO *FL_NOT_EXIST
15280 OPEN "I",#1,FL_NAME$
15290 CLOSE (1)
15300 *FL_EXIST2
15310 ON ERROR GOTO 0
15320 RETURN
15330 *FL_NOT_EXIST
15340 FL_EXIST = 0
15350 RESUME *FL_EXIST2
15360 '
15370 *FL_SKIP 'kill fileのスキップ
15380 RESUME NEXT
15390 '
15400 '---- フォント表示 ----
15410 *FNT_PUT
15420 ' in sj_code& put_type put_back buf
15430 IF SJ_CODE& <> BUF_TOP&(BUF) OR BUF_PUT = 1 THEN
15440 LINE (320*BUF+3,3)-STEP(319-3*2,319-3*2),PSET,0,BF
15450 IF SJ_CODE& < 256 THEN
15460 GOSUB *FNT_ANK
15470 ELSE
15480 ' 最後尾の表示位置を補正 (dim ft%(n,buf)の宣言より後ろを参照しないように)
15490 SJ_CODE& = FNBTMCHK&(SJ_CODE&)
15500 GOSUB *FNT_SJIS
15510 ENDIF
15520 ENDIF
15530 BUF_PUT = 0
15540 BUF_TOP&(BUF) = SJ_CODE&
15550 RETURN
15560 '
15570 *FNT_SJIS
15580 IF SJ_CODE& < &H8140 THEN SJ_CODE& = &H8140
15590 'SJ_CODE& = FNSJADJ&(SJ_CODE&)
15600 'LINE (320*BUF+3,10)-STEP(319-3*2,299-3*2),PSET,0,BF
15610 OFX = 15+320*BUF
15620 OFY = 10+3
15630 DC& = SJ_CODE&
15640 ' -- 2ドット 空きを付けて 表示 --
15650 IF PUT_TYPE = 0 THEN
15660 FOR I = 0 TO 15
15670 SYMBOL (OFX + 6*6 + I*14,OFY)," "+HEX$(I),12/16,12/16
15680 NEXT
15690 FOR Y = 1 TO 20
15700 SYMBOL (OFX, OFY + Y*14),HEX$(DC&)+":",12/16,12/16
15710 FOR X = 0 TO 15
15720 DX = OFX + X*14 + 6*6
15730 DY = OFY + Y*14
15740 GOSUB *FNT_SJIS_SUB
15750 ODC& = DC&
15760 DC& = FNSJADJ&(DC&+1)
15770 IF ODC& +1 <> DC& THEN X = 15
15780 NEXT
15790 I$ = INKEY$
15800 IF I$ = "-" OR I$ = CHR$(&H1F) OR I$ = " " THEN Y = 20 '表示中断
15810 NEXT
15820 ' -- 空きなし表示 --
15830 ELSE IF PUT_TYPE = 1 THEN
15840 FOR Y = 0 TO 23
15850 SYMBOL (OFX, OFY + Y*12),HEX$(DC&)+":",12/16,12/16
15860 FOR X = 0 TO 20
15870 DX = OFX + X*12 + 6*6
15880 DY = OFY + Y*12
15890 GOSUB *FNT_SJIS_SUB
15900 ODC& = DC&
15910 DC& = FNSJADJ&(DC&+1)
15920 IF ODC& +1 <> DC& THEN X = 20
15930 NEXT
15940 I$ = INKEY$
15950 IF I$ = "-" OR I$ = CHR$(&H1F) OR I$ = " " THEN Y = 23 '表示中断
15960 NEXT
15970 ' -- sjis code, 16x16 font と共に表示 --
15980 ELSE IF PUT_TYPE = 2 THEN
15990 FOR Y = 0 TO 10
16000 FOR X = 0 TO 9
16010 DX = OFX + X*30
16020 DY = OFY + Y*26
16030 GOSUB *FNT_SJIS_SUB
16040 IF PUT_BACK <> 0 THEN
16050 LINE (DX+12,DY)-STEP(15,15),PSET,2,BF
16060 ENDIF
16070 SYMBOL (DX+12,DY),FNSJCH$(DC&),1,1 '16x16 font
16080 SYMBOL (DX, DY+16),HEX$(DC&),10/16,9/16 'sjis code
16090 DC& = FNSJADJ&(DC& + 1)
16100 NEXT
16110 I$ = INKEY$
16120 IF I$ = "-" OR I$ = CHR$(&H1F) OR I$ = " " THEN Y = 20 '表示中断
16130 NEXT
16140 ELSE
16150 PRINT "**error put_type "
16160 ENDIF
16170 RETURN
16180 '
16190 *FNT_SJIS_SUB
16200 ' in dc,dx,dy
16210 ' -- 12x12 全角フォント表示用サブ --
16220 AD& = FNSJAD&(DC&)/2
16230 FOR I = 0 TO 11
16240 DSP%(I) = FT%(AD& + I,BUF) 'font data から 抜き出す
16250 NEXT
16260 IF PUT_BACK <> 0 THEN
16270 LINE (DX,DY)-STEP(11,11),PSET,1,BF
16280 ENDIF
16290 PUT@(DX,DY)-(DX+11,DY+11),DSP%
16300 RETURN
16310 '
16320 *FNT_ANK
16330 ' -- 6x12 半角フォント表示用 --
16340 LINE (10+320*BUF,10)-STEP(299,299),PSET,0,BF
16350 ST_X = (PUT_TYPE = 0)*-9 + (PUT_TYPE = 1)*-6 + (PUT_TYPE = 2)*-16 '表示間隔
16360 ST_Y = (PUT_TYPE = 0)*-15 + (PUT_TYPE = 1)*-12 + (PUT_TYPE = 2)*-18 '
16370 OF_X = 10+320*BUF
16380 OF_Y = 12
16390 'SYMBOL (OF_X+20,OFY),"0 1 2 3 4 5 6 7 8 9 A B C D E F",1,1
16400 FOR I = 0 TO 15
16410 SYMBOL(OF_X,OF_Y+(I+1)*ST_Y),HEX$(I)+"0",12/16,12/16 '縦
16420 SYMBOL(OF_X+20+ST_X*I,OFY),HEX$(I),12/16,12/16 '横
16430 NEXT
16440 FOR Y = 0 TO 15
16450 FOR X = 0 TO 15
16460 IF PUT_BACK <> 0 THEN
16470 LINE (OF_X+20+X*ST_X,OF_Y+(Y+1)*ST_Y)-STEP(5,12),PSET,1,BF
16480 ENDIF
16490 FOR I = 0 TO 5
16500 DSP%(I) = FT%((Y*16+X)*6+I,BUF)
16510 NEXT
16520 PUT@ (OF_X+20+X*ST_X,OF_Y+(Y+1)*ST_Y)-(OF_X+20+X*ST_X+5,OF_Y+(Y+1)*ST_Y+11),DSP%
16530 IF PUT_TYPE = 2 THEN ' 8x16 font 表示
16540 IF PUT_BACK <> 0 THEN
16550 LINE (OF_X+26+X*ST_X,OF_Y+(Y+1)*ST_Y)-STEP(7,15),PSET,2,BF
16560 ENDIF
16570 I = Y*16+X
16580 IF I < &H7F OR (&HA0 <= I AND I <= &HDF) THEN
16590 SYMBOL (OF_X+26+X*ST_X,OF_Y+(Y+1)*ST_Y),CHR$(I),1,1,7
16600 ENDIF
16610 ENDIF
16620 NEXT
16630 I$ = INKEY$
16640 IF I$ = " " OR I$ = "-" OR I$ = CHR$(&H1F) THEN Y = 15 '表示中断
16650 NEXT
16660 RETURN
16670 '
16680 '---- コード選択 ----
16690 *SEL_CODE
16700 '処理範囲指定用
16710 CLS 1
16720 PRINT
16730 PRINT "どの種類から? ← → 選択 (↑表示 , RET決定)"
16740 SEL_BNK = 0: SEL_CSR = 2 '全角から選択始め
16750 GOSUB *SEL_AR
16760 SEL_TOP& = SEL_OUT&
16770 PRINT "どの種類まで? ← → 選択 (↑表示 , RET決定)"
16780 SEL_BNK = 1 'コードの終わり側
16790 GOSUB *SEL_AR
16800 SEL_BTM& = SEL_OUT&
16810 'sel_top < sel_btm の確認
16820 IF SEL_TOP& > SEL_BTM& THEN
16830 SWAP SEL_TOP&,SEL_BTM&
16840 ENDIF
16850 'ank sjisに跨がらないこと
16860 IF SEL_TOP& < 256 AND SEL_BTM& => &H8140 THEN
16870 PRINT "ANK 全角文字にまたがる指定は出来ません。(any key)"
16880 I$ = INPUT$(1)
16890 GOTO *SEL_CODE '再入力
16900 ENDIF
16910 CLS 1
16920 SJ_CODE& = SEL_TOP& '選択した頭を表示
16930 GOSUB *FNT_PUT
16940 RETURN
16950 '
16960 'カ-ソルの左右で 範囲を選択
16970 *SEL_AR
16980 I$ = ""
16990 WHILE I$ <> CHR$(13)
17000 PRINT USING CHR$(13)+" ## [& &] ($& &)";SEL_CSR;SEL_NM$(SEL_CSR);HEX$(SEL_BK&(SEL_CSR,SEL_BNK));
17010 I$ = INKEY$
17020 IF I$ = CHR$(&H1C) OR I$ = "6" THEN ' right-ar "6"
17030 SEL_CSR = SEL_CSR + 1
17040 IF SEL_CSR > SEL_MAX-1 THEN SEL_CSR = 0
17050 ELSE IF I$ = CHR$(&H1D) OR I$ = "4" THEN ' left-ar "4"
17060 SEL_CSR = SEL_CSR - 1
17070 IF SEL_CSR < 0 THEN SEL_CSR = SEL_MAX -1
17080 ELSE IF I$ = CHR$(&H1E) OR I$ = "8" OR I$ = "5" THEN ' up-ar "8" "5"
17090 SJ_CODE& = SEL_BK&(SEL_CSR,0) '表示は頭の方を
17100 GOSUB *FNT_PUT
17110 ENDIF
17120 WEND
17130 'PRINT
17140 IF SEL_CSR > 0 THEN
17150 PRINT
17160 SEL_OUT& = SEL_BK&(SEL_CSR,SEL_BNK)
17170 ELSE IF SEL_CSR = 0 THEN
17180 *SEL_AR2
17190 ' -- sjisコードで入力 --
17200 LOCATE 0,CSRLIN '-1
17210 PRINT CHR$(13)+" "+CHR$(13)+" コード入力 >";
17220 LINE INPUT I$
17230 IF I$ = "" THEN
17240 LOCATE 0,CSRLIN -1
17250 PRINT CHR$(13)+" "+CHR$(13);
17260 GOTO *SEL_AR
17270 ELSE IF LEN(KMID$(I$,1,1)) = 2 THEN
17280 SEL_OUT& = ASC(MID$(I$,1,1))*256 + ASC(MID$(I$,2,1)) '全角文字の時
17290 ELSE
17300 SEL_OUT& = VAL("&h"+I$) 'sjis coseの時
17310 ENDIF
17320 ' -- コードのcheck --
17330 IF SEL_OUT& < 0 THEN
17340 GOTO *SEL_AR2
17350 ELSE IF 255 < SEL_OUT& AND SEL_OUT& < &H8140 THEN
17360 GOTO *SEL_AR2
17370 ELSE IF &H9872 < SEL_OUT& THEN
17380 GOTO *SEL_AR2
17390 ELSE IF &H8140 <= SEL_OUT& AND SEL_OUT& <= &H9872 THEN
17400 SEL_OUT& = FNSJADJ&(SEL_OUT&) 'sjis code の調整
17410 ELSE 'if 0 <= sel_out& and sel_out& <= 255 then
17420 '
17430 ENDIF
17440 ELSE IF SEL_CODE < 0 THEN
17450 PRINT "sel_code error"
17460 STOP
17470 ENDIF
17480 RETURN
17490 '
17500 '-------------------------- PROGRAM END ------------------------------------------------------